home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / programm.ing / m2gem106.lzh / CRYSTAL1.06 / SRC / CRYSTAL / VQUERY.MOD < prev    next >
Encoding:
Modula Implementation  |  1993-07-31  |  12.5 KB  |  527 lines
  1. IMPLEMENTATION MODULE VQuery;
  2.  
  3. (*
  4. VDI Query Functions.
  5.  
  6. UK __DATE__ __TIME__
  7. *)
  8.  
  9. (*IMP_SWITCHES*)
  10.  
  11. FROM VDI        IMPORT contrl,intin,ptsin,intout,ptsout,v,CallVDI,RGBList,
  12.                        MaxInput,IntegerOutputRange,EOS,
  13.                        XY,Integer,Point,ColorIntensity;
  14. FROM VAttribute IMPORT WritingModes,LineTypes,LineEnds,MarkerTypes,
  15.                        TextEffect,
  16.                        HorizontalAlignments,VerticalAlignments,
  17.                        Interiors;
  18. FROM VInput     IMPORT Devices,InputModes;
  19. #if ST
  20. FROM VControl   IMPORT VQFSMGDOS,VQSpeedoGDOS;
  21. #endif
  22. FROM PORTAB     IMPORT UNSIGNEDWORD,SIGNEDWORD,ANYWORD,ANYPOINTER,
  23.                        UNSIGNEDLONG,ANYTYPE;
  24. FROM SYSTEM     IMPORT ADR;
  25. CAST_IMPORT
  26.  
  27. PROCEDURE VQExtnd(    Handle : UNSIGNEDWORD;
  28.                       Flag   : BOOLEAN;
  29.                   VAR WorkOut: ARRAY OF UNSIGNEDWORD);
  30. #if long
  31. VAR i: [0..56];
  32. #endif
  33.  
  34. BEGIN
  35. #if long
  36.   FOR i:= 0 TO 44 DO
  37.     WorkOut[i]:= intout[i];
  38.   END;
  39.   FOR i:= 45 TO 56 DO
  40.     WorkOut[i]:= ptsout[i - 45];
  41.   END;
  42. #else
  43.   v.iooff:= ADR(WorkOut);
  44.   v.pooff:= ADR(WorkOut[45]);
  45. #endif
  46.   intin[0]:= ORD(Flag);
  47.   CallVDI(102,0,1,Handle);
  48. #if not long
  49.   v.iooff:= ADR(intout);
  50.   v.pooff:= ADR(ptsout);
  51. #endif
  52. END VQExtnd;
  53.  
  54. PROCEDURE VQColor(    Handle: UNSIGNEDWORD;
  55.                       Color : UNSIGNEDWORD;
  56.                       Flag  : BOOLEAN;
  57.                   VAR RGB   : RGBList): UNSIGNEDWORD;
  58. BEGIN
  59.   intin[0]:= ORD(Color);
  60.   intin[1]:= ORD(Flag);
  61.   CallVDI(26,0,2,Handle);
  62.   WITH RGB DO
  63.     Red:= intout[1];
  64.     Green:= intout[2];
  65.     Blue:= intout[3];
  66.   END;
  67.   RETURN intout[0];
  68. END VQColor;
  69.  
  70. PROCEDURE VQLAttributes(    Handle: UNSIGNEDWORD;
  71.                         VAR Attrib: ARRAY OF ANYTYPE);
  72.  
  73. VAR P: POINTER TO LineAttributes;
  74.  
  75. BEGIN
  76.   CallVDI(35,0,0,Handle);
  77.   P:= ADR(Attrib);
  78.   WITH P^ DO
  79.     Type:= VAL(LineTypes,intout[0]);
  80.     Color:= intout[1];
  81.     Mode:= VAL(WritingModes,intout[2]);
  82.     Width:= ptsout[0];
  83.     Begin:= LESquared;
  84.     End:= LESquared;
  85.     IF contrl.c[4] > 3 THEN
  86.       Begin:= VAL(LineEnds,intout[3]);
  87.       End:= VAL(LineEnds,intout[4]);
  88.     END;
  89.   END;
  90. END VQLAttributes;
  91.  
  92. PROCEDURE VQMAttributes(    Handle: UNSIGNEDWORD;
  93.                         VAR Attrib: ARRAY OF ANYTYPE);
  94.  
  95. VAR P: POINTER TO MarkerAttributes;
  96.  
  97. BEGIN
  98.   CallVDI(36,0,0,Handle);
  99.   P:= ADR(Attrib);
  100.   WITH P^ DO
  101.     Type:= VAL(MarkerTypes,intout[0]);
  102.     Color:= intout[1];
  103.     Mode:= VAL(WritingModes,intout[2]);
  104.     Height:= ptsout[1];
  105.     Width:= 1;
  106.     IF contrl.c[4] > 3 THEN
  107.       Width:= intout[3];
  108.     END;
  109.     IF ptsout[0] > 0 THEN
  110.       Width:= ptsout[0];
  111.     END;
  112.   END;
  113. END VQMAttributes;
  114.  
  115. PROCEDURE VQFAttributes(    Handle: UNSIGNEDWORD;
  116.                         VAR Attrib: ARRAY OF ANYTYPE);
  117.  
  118. VAR P: POINTER TO FillAttributes;
  119.  
  120. BEGIN
  121.   CallVDI(37,0,0,Handle);
  122.   P:= ADR(Attrib);
  123.   WITH P^ DO
  124.     Interior:= VAL(Interiors,intout[0]);
  125.     Color:= intout[1];
  126.     Fill:= intout[2];
  127.     Mode:= VAL(WritingModes,intout[3]);
  128.     Perimeter:= intout[4] = 1;
  129.   END;
  130. END VQFAttributes;
  131.  
  132. PROCEDURE VQTAttributes(    Handle: UNSIGNEDWORD;
  133.                         VAR Attrib: ARRAY OF ANYTYPE);
  134.  
  135. VAR P: POINTER TO TextAttributes;
  136.  
  137. BEGIN
  138.   CallVDI(38,0,0,Handle);
  139.   P:= ADR(Attrib);
  140.   WITH P^ DO
  141.     Font:= intout[0];
  142.     Color:= intout[1];
  143.     Rotation:= intout[2];
  144.     Horizontal:= VAL(HorizontalAlignments,intout[3]);
  145.     Vertical:= VAL(VerticalAlignments,intout[4]);
  146.     Mode:= VAL(WritingModes,intout[5]);
  147.     Width:= ptsout[0];
  148.     Height:= ptsout[1];
  149.     CellWidth:= ptsout[2];
  150.     CellHeight:= ptsout[3];
  151.   END;
  152. END VQTAttributes;
  153.  
  154. PROCEDURE VQTExtent(    Handle: UNSIGNEDWORD;
  155.                     VAR String: ARRAY OF CHAR;
  156.                     VAR Extent: ARRAY OF XY);
  157.  
  158. VAR i: [0..MaxInput];
  159. #if long
  160.     j: [0..7];
  161. #endif
  162.  
  163. BEGIN
  164.   i:= 0;
  165.   WHILE String[i] # EOS DO
  166.     intin[i]:= ORD(String[i]);
  167.     INC(i);
  168.   END;
  169. #if not long
  170.   v.pooff:= ADR(Extent);
  171. #endif
  172.   CallVDI(116,0,i,Handle); (* (i - 1) + 1 = i *)
  173. #if long
  174.   FOR j:= 0 TO 7 DO
  175.     Extent[j]:= ptsout[j];
  176.   END;
  177. #else
  178.   v.pooff:= ADR(ptsout);
  179. #endif
  180. END VQTExtent;
  181.  
  182. PROCEDURE VQTWidth(    Handle     : UNSIGNEDWORD;
  183.                        Char       : CHAR;
  184.                    VAR CellWidth  : UNSIGNEDWORD;
  185.                    VAR LeftOffset : UNSIGNEDWORD;
  186.                    VAR RightOffset: UNSIGNEDWORD): SIGNEDWORD;
  187. BEGIN
  188.   intin[0]:= ORD(Char);
  189.   CallVDI(117,0,1,Handle);
  190.   CellWidth:= ptsout[0];
  191.   LeftOffset:= ptsout[2];
  192.   RightOffset:= ptsout[4];
  193.   RETURN intout[0];
  194. END VQTWidth;
  195.  
  196. PROCEDURE VQTName(   Handle: UNSIGNEDWORD;
  197.                      FontNo: UNSIGNEDWORD;
  198.                  VAR Name  : ARRAY OF CHAR;
  199.                  VAR VecFnt: BOOLEAN): UNSIGNEDWORD;
  200.  
  201. VAR i: [0..31];
  202.  
  203. BEGIN
  204.   intin[0]:= FontNo;
  205.   CallVDI(130,0,1,Handle);
  206.  
  207.   FOR i:= 0 TO 31 DO
  208.     Name[i]:= CHR(intout[i + 1]);
  209.   END;
  210.   Name[32]:= EOS;
  211.  
  212. #if ST
  213.   VecFnt:= intout[33] = 1;
  214. #else
  215.   VecFnt:= FALSE;
  216. #endif
  217.   RETURN intout[0];
  218. END VQTName;
  219.  
  220. PROCEDURE VQCellArray(    Handle   : UNSIGNEDWORD;
  221.                       VAR PXY      : ARRAY OF XY;
  222.                           RowLength: UNSIGNEDWORD;
  223.                           NumRows  : UNSIGNEDWORD;
  224.                       VAR ElUsed   : UNSIGNEDWORD;
  225.                       VAR RowsUsed : UNSIGNEDWORD;
  226.                       VAR Status   : BOOLEAN;
  227.                       VAR ColArray : ARRAY OF ANYWORD);
  228. #if long
  229. VAR i: [0..3];
  230. #endif
  231.  
  232. BEGIN
  233. #if long
  234.   FOR i:= 0 TO 3 DO
  235.     ptsin[i]:= PXY[i];
  236.   END;
  237. #else
  238.   v.pioff:= ADR(PXY);
  239. #endif
  240.   v.iioff:= ADR(ColArray);
  241.   contrl.c[7]:= RowLength;
  242.   contrl.c[8]:= NumRows;
  243.   CallVDI(27,2,0,Handle);
  244.   ElUsed:= contrl.c[9];
  245.   RowsUsed:= contrl.c[10];
  246.   Status:= contrl.c[11] = 0;
  247. #if not long
  248.   v.pioff:= ADR(ptsin);
  249. #endif
  250.   v.iioff:= ADR(intout);
  251. END VQCellArray;
  252.  
  253. PROCEDURE VQInMode(    Handle   : UNSIGNEDWORD;
  254.                        DevType  : Devices;
  255.                    VAR InputMode: InputModes);
  256. BEGIN
  257.   intin[0]:= ORD(DevType);
  258.   CallVDI(115,0,1,Handle);
  259.   InputMode:= VAL(InputModes,intout[0]);
  260. END VQInMode;
  261.  
  262. PROCEDURE VQTFontInfo(    Handle   : UNSIGNEDWORD;
  263.                       VAR LowADE   : UNSIGNEDWORD;
  264.                       VAR HighADE  : UNSIGNEDWORD;
  265.                       VAR Distances: ARRAY OF UNSIGNEDWORD;
  266.                       VAR MaxWidth : UNSIGNEDWORD;
  267.                       VAR Effects  : ARRAY OF UNSIGNEDWORD);
  268. BEGIN
  269.   CallVDI(131,0,0,Handle);
  270.   LowADE:= intout[0];
  271.   HighADE:= intout[1];
  272.   MaxWidth:= ptsout[0];
  273.   Distances[0]:= ptsout[1];
  274.   Distances[1]:= ptsout[3];
  275.   Distances[2]:= ptsout[5];
  276.   Distances[3]:= ptsout[7];
  277.   Distances[4]:= ptsout[9];
  278.   Effects[0]:= ptsout[2];
  279.   Effects[1]:= ptsout[4];
  280.   Effects[2]:= ptsout[6];
  281. END VQTFontInfo;
  282.  
  283. PROCEDURE VQTJustified(    Handle   : UNSIGNEDWORD;
  284.                            X        : XY;
  285.                            Y        : XY;
  286.                        VAR String   : ARRAY OF CHAR;
  287.                            Length   : UNSIGNEDWORD;
  288.                            WordSpace: BOOLEAN;
  289.                            CharSpace: BOOLEAN;
  290.                        VAR Offsets  : ARRAY OF UNSIGNEDWORD);
  291.  
  292. VAR i,j: [0..(MaxInput + 1)];
  293.  
  294. BEGIN
  295.   intin[0]:= ORD(WordSpace);
  296.   intin[1]:= ORD(CharSpace);
  297.   i:= 0;
  298.   WHILE String[i] # EOS DO
  299.     intin[i + 2]:= ORD(String[i]);
  300.     INC(i);
  301.   END;
  302.   ptsin[0]:= X;
  303.   ptsin[1]:= Y;
  304.   ptsin[2]:= Length;
  305.   ptsin[3]:= 0;
  306. #if not long
  307.   v.pooff:= ADR(Offsets);
  308. #endif
  309.   CallVDI(132,2,i + 1,Handle); (* (i - 1) + 2 = i + 1 *)
  310. #if long
  311.   FOR j:= 0 TO (2 * i - 2) DO (* 2 * (i - 1) = 2 * i - 2 *)
  312.     Offsets[j]:= ptsout[j];
  313.   END;
  314. #else
  315.   v.pooff:= ADR(ptsout);
  316. #endif
  317. END VQTJustified;
  318.  
  319. PROCEDURE VQTAdvance(    Handle: UNSIGNEDWORD;
  320.                          Ch    : CHAR;
  321.                      VAR XAdv  : UNSIGNEDWORD;
  322.                      VAR YAdv  : UNSIGNEDWORD;
  323.                      VAR XRem  : UNSIGNEDWORD;
  324.                      VAR YRem  : UNSIGNEDWORD);
  325. BEGIN
  326. #if ST
  327.   IF VQFSMGDOS() THEN
  328.     intin[0]:= ORD(Ch);
  329.     CallVDI(247,0,1,Handle);
  330.     XAdv:= ptsout[0];
  331.     YAdv:= ptsout[1];
  332.     XRem:= ptsout[2];
  333.     YRem:= ptsout[3];
  334.   END;
  335. #else
  336.   intout[0]:= 0; (* error *)
  337. #endif
  338. END VQTAdvance;
  339.  
  340. PROCEDURE VQTAdvance32(    Handle: UNSIGNEDWORD;
  341.                            Ch    : CHAR;
  342.                        VAR XAdv  : UNSIGNEDLONG;
  343.                        VAR YAdv  : UNSIGNEDLONG);
  344.  
  345. VAR P: POINTER TO ARRAY[0..1] OF UNSIGNEDLONG;
  346.  
  347. BEGIN
  348. #if ST
  349.   IF VQFSMGDOS() THEN
  350.     intin[0]:= ORD(Ch);
  351.     CallVDI(247,0,1,Handle);
  352.     P:= ADR(ptsout[4]);
  353.     XAdv:= P^[0];
  354.     YAdv:= P^[1];
  355.   END;
  356. #endif
  357. END VQTAdvance32;
  358.  
  359. PROCEDURE VQTDevInfo(    Handle: UNSIGNEDWORD;
  360.                          Device: UNSIGNEDWORD;
  361.                      VAR Exists: BOOLEAN;
  362.                      VAR DevStr: ARRAY OF CHAR);
  363. #if ST
  364. VAR i: IntegerOutputRange;
  365. #endif
  366.  
  367. BEGIN
  368. #if ST
  369.   intin[0]:= Device;
  370.   CallVDI(248,0,1,Handle);
  371.   Exists:= ptsout[0] # 0;
  372.   i:= 0;
  373.   IF Exists THEN
  374.     WHILE i < contrl.c[4] DO
  375.       DevStr[i]:= CHR(CAST(UNSIGNEDWORD,intout[i]));
  376.       INC(i);
  377.     END;
  378.   END;
  379.   DevStr[i]:= EOS;
  380. #endif
  381. END VQTDevInfo;
  382.  
  383. PROCEDURE VQTGetTable(    Handle: UNSIGNEDWORD;
  384.                       VAR Map   : ANYPOINTER);
  385. #if ST
  386. VAR P: POINTER TO ANYPOINTER;
  387. #endif
  388.  
  389. BEGIN
  390. #if ST
  391.   IF VQFSMGDOS() THEN
  392.     CallVDI(254,0,0,Handle);
  393.     P:= ADR(intout);
  394.     Map:= P^;
  395.   END;
  396. #endif
  397. END VQTGetTable;
  398.  
  399. PROCEDURE VQTCacheSize(    Handle: UNSIGNEDWORD;
  400.                            Cache : UNSIGNEDWORD;
  401.                        VAR Size  : UNSIGNEDLONG);
  402. #if ST
  403. VAR P: POINTER TO UNSIGNEDLONG;
  404. #endif
  405. BEGIN
  406. #if ST
  407.   IF VQFSMGDOS() THEN
  408.     intin[0]:= Cache;
  409.     CallVDI(255,0,1,Handle);
  410.     P:= ADR(intout);
  411.     Size:= P^;
  412.   END;
  413. #endif
  414. END VQTCacheSize;
  415.  
  416. PROCEDURE VQTFExtent(    Handle: UNSIGNEDWORD;
  417.                      VAR String: ARRAY OF CHAR;
  418.                      VAR Extent: ARRAY OF XY);
  419.  
  420. VAR i: [0..MaxInput];
  421. #if long
  422.     j: [0..7];
  423. #endif
  424.  
  425. BEGIN
  426.   i:= 0;
  427.   WHILE String[i] # EOS DO
  428.     intin[i]:= ORD(String[i]);
  429.     INC(i);
  430.   END;
  431. #if not long
  432.   v.pooff:= ADR(Extent);
  433. #endif
  434.   CallVDI(240,0,i,Handle); (* (i - 1) + 1 = i *)
  435. #if long
  436.   FOR j:= 0 TO 7 DO
  437.     Extent[j]:= ptsout[j];
  438.   END;
  439. #else
  440.   v.pooff:= ADR(ptsout);
  441. #endif
  442. END VQTFExtent;
  443.  
  444. PROCEDURE VQTFontHeader(    Handle: UNSIGNEDWORD;
  445.                         VAR Buffer: ARRAY OF ANYTYPE;
  446.                         VAR Path  : ARRAY OF CHAR);
  447.  
  448. VAR P: POINTER TO ANYPOINTER;
  449.     i: [0..128]; (* should be enough *)
  450.  
  451. BEGIN
  452. #if ST
  453.   IF VQSpeedoGDOS() THEN
  454.     P:= ADR(intin);
  455.     P^:= ADR(Buffer);
  456.     CallVDI(232,0,2,Handle);
  457.     FOR i:= 0 TO (contrl.c[4] - 1) DO
  458.       Path[i]:= CHR(intout[i]);
  459.     END;
  460.     Path[contrl.c[4]]:= EOS;
  461.   ELSE
  462.     Path[0]:= EOS;
  463.   END;
  464. #else
  465.   intout[0]:= 0; (* error *)
  466. #endif
  467. END VQTFontHeader;
  468.  
  469. PROCEDURE VQTTrackKern(    Handle: UNSIGNEDWORD;
  470.                        VAR X     : UNSIGNEDLONG;
  471.                        VAR Y     : UNSIGNEDLONG);
  472.  
  473. VAR P: POINTER TO ARRAY[0..1] OF UNSIGNEDLONG;
  474.  
  475. BEGIN
  476.   CallVDI(234,0,0,Handle);
  477.   P:= ADR(ptsout); (* st computer 8/93: intout !? *)
  478.   X:= P^[0];
  479.   Y:= P^[1];
  480. END VQTTrackKern;
  481.  
  482. PROCEDURE VQTPairKern(    Handle: UNSIGNEDWORD;
  483.                           Ch1   : CHAR;
  484.                           Ch2   : CHAR;
  485.                       VAR X     : UNSIGNEDLONG;
  486.                       VAR Y     : UNSIGNEDLONG);
  487.  
  488. VAR P: POINTER TO ARRAY[0..1] OF UNSIGNEDLONG;
  489.  
  490. BEGIN
  491.   intin[0]:= ORD(Ch1);
  492.   intin[1]:= ORD(Ch2);
  493.   CallVDI(235,0,2,Handle);
  494.   P:= ADR(ptsout); (* st computer 8/93: intout !? *)
  495.   X:= P^[0];
  496.   Y:= P^[1];
  497. END VQTPairKern;
  498.  
  499. PROCEDURE VGetBitmapInfo(    Handle: UNSIGNEDWORD;
  500.                              Ch    : CHAR;
  501.                          VAR AdvX  : UNSIGNEDLONG;
  502.                          VAR AdvY  : UNSIGNEDLONG;
  503.                          VAR XOff  : UNSIGNEDLONG;
  504.                          VAR YOff  : UNSIGNEDLONG;
  505.                          VAR Width : UNSIGNEDWORD;
  506.                          VAR Height: UNSIGNEDWORD;
  507.                          VAR Bitmap: ANYPOINTER);
  508.  
  509. VAR P: POINTER TO ARRAY[0..3] OF UNSIGNEDLONG;
  510.     Q: POINTER TO ANYPOINTER;
  511.  
  512. BEGIN
  513.   intin[0]:= ORD(Ch);
  514.   CallVDI(239,0,1,Handle);
  515.   Width:= intout[0];
  516.   Height:= intout[1];
  517.   P:= ADR(intout[2]);
  518.   AdvX:= P^[0];
  519.   AdvY:= P^[1];
  520.   XOff:= P^[2];
  521.   YOff:= P^[3];
  522.   Q:= ADR(intout[10]);
  523.   Bitmap:= Q^;
  524. END VGetBitmapInfo;
  525.  
  526. END VQuery.
  527.